\ dblmath 97.11.29 NAB

needs core-ext

: dm* ( d n -- d*n)  1 m*/ ;
: dm/ ( d +n -- d/n)  1 swap m*/ ;

true  dup 1 rshift  xor  constant HiBit

: ud/mod ( ud1 ud2 -- udr udq)
  2dup 2>r
  2over 2over du<  over HiBit and  or
  if  2drop 0.
  else  2dup d+  recurse  d2*  then
  2swap 2r>
  2over 2over du<  if  2drop 2swap
  else  d-  2swap 1 m+  then ;

: dmod ( d +n -- +m)
\ Mixed-precision modulo:
  >r  2dup  r@ dm/  r> dm*  d-  d>s ;

: admod ( d +n -- +m)
\ Like dmod, but m=n when result=0:
  >r  -1 m+  r> dmod  1+ ;
